home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / BPAS9.ARJ / FACTRL2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-07  |  4KB  |  173 lines
  1. {---------------------------------------------------------------------
  2.  PROGRAM: FACTORIAL2.PAS
  3.  
  4.  This program is taken from:
  5.  
  6.       Leestma, Sanford and Larry Nyhoff
  7.         Pascal: Programming and Problem Solving
  8.         MacMillan, 1984
  9.         pp. 162 and 192
  10.  
  11.  Its purpose is to examine two ways to calculate factorial.  One is
  12.  through a FOR DO loop, the other is through Recursion.
  13.  
  14.  INPUT:
  15.  
  16.  OUTPUT:
  17.  
  18.  VAR:
  19.  
  20.  
  21.  Author:                    Mike Benedict
  22.  Date Started:              5/27/91
  23.  Latest Revision:           5/27/91
  24.  Version:                   Turbo Pascal 6.0
  25.  
  26.  -------------------------------------------------------------------}
  27.  
  28. PROGRAM Factrl2 (Input, Output);
  29.  
  30. USES
  31.   Crt;
  32.  
  33. CONST
  34.   MaxM  =  7;
  35. VAR
  36.   Choice,
  37.   M            :  Integer;
  38.   UserQuits    :  BOOLEAN;
  39.  
  40. {------------------------------------}
  41. {            PROCEDURES              }
  42. {------------------------------------}
  43.  
  44. {-----------------------------}
  45. {          INIT.PROC          }
  46. {-----------------------------}
  47.  
  48. PROCEDURE Init;
  49.  
  50. BEGIN
  51.   TextBackground(Blue);                   { Sets colors                     }
  52.   TextColor(White);
  53.   Window(0,0,80,25);
  54.   ClrScr;
  55. END;
  56.  
  57.  
  58.  
  59. {-----------------------------}
  60. {         .PROC           }
  61. {-----------------------------}
  62.  
  63. PROCEDURE Null;
  64.  
  65. BEGIN
  66. END;
  67.  
  68. {-----------------------------}
  69. {      FACTFORDO .PROC        }
  70. {-----------------------------}
  71.  
  72. PROCEDURE FactForDo;
  73.  
  74. VAR
  75.   k,                                   { index }
  76.   FAC,
  77.   Factorial         :  INTEGER;        { partial factorial }
  78.  
  79. BEGIN
  80.   ClrScr;
  81.   WriteLn;
  82.   Write(' ':20,' Enter an integer - 0 to ',MaxM,': ');
  83.   ReadLn(M);
  84.   IF M <= MaxM THEN
  85.     BEGIN
  86.       FAC := 1;
  87.       FOR k := 2 to M DO
  88.         FAC := FAC * K;
  89.       Factorial := FAC;
  90.       WriteLn;
  91.       WriteLn(' ':20,'          M was entered as: ', M );
  92.       WriteLn;
  93.       WriteLn(' ':20,'       M!, or M Factorial = ', Factorial );
  94.     END
  95.     ELSE
  96.       BEGIN
  97.         WriteLn;
  98.         WriteLn('The number you entered is greater than ',MaxM,'.  Re-enter. ');
  99.       END;  { ELSE }
  100.   WriteLn;
  101.   WriteLn(' Press <ENTER> to return to menu.');
  102.   ReadLn;
  103. END;      {FactForDo}
  104.  
  105.  
  106.  
  107. {-----------------------------}
  108. {      FACTORIAL.PROC         }
  109. {-----------------------------}
  110.  
  111. FUNCTION Factorial ( M : Integer ) : Integer;
  112.  
  113. BEGIN
  114.   IF M = 0 THEN
  115.     Factorial := 1
  116.   ELSE
  117.     Factorial := M * Factorial( M-1 );
  118. END;      { Factorial }
  119.  
  120.  
  121. {-----------------------------}
  122. {        FACTREC.PROC         }
  123. {-----------------------------}
  124.  
  125. PROCEDURE FactRec;
  126.  
  127. BEGIN
  128.   ClrScr;
  129.   WriteLn;
  130.   Write(' ':20,'Enter an integer - 0 to ',MaxM,': ');
  131.   ReadLn(M);
  132.   WriteLn;
  133.   IF M > MaxM THEN
  134.     WriteLn('The number you entered is greater than ',MaxM,'.  Re-enter. ')
  135.     ELSE
  136.       BEGIN
  137.         WriteLn;
  138.         WriteLn(' ':20,'          M was entered as: ', M );
  139.         M := Factorial( M );
  140.       END;  { ELSE }
  141.   WriteLn;
  142.   WriteLn(' ':20,'       M!, or M Factorial = ', M );
  143.   WriteLn;
  144.   WriteLn(' Press <ENTER> to return to menu.');
  145.   ReadLn;
  146. END;      {FactRec}
  147.  
  148.  
  149.  
  150. {------------------------------------}
  151. {           MAIN PROGRAM             }
  152. {------------------------------------}
  153.  
  154. BEGIN
  155.   Init;
  156.   UserQuits := False;
  157.   REPEAT
  158.     ClrScr;
  159.     WriteLn;
  160.     WriteLn(' ':25, ' Menu For Factorial Methods ' );
  161.     WriteLn;
  162.     WriteLn(' ':20, ' 1.  Factorial Using a FOR DO Loop' );
  163.     WriteLn(' ':20, ' 2.  Factorial Using Recursion'     );
  164.     WriteLn(' ':20, ' 3.  Quit '                         );
  165.     ReadLn ( Choice );
  166.     CASE Choice OF
  167.        1  :  FactForDo;
  168.        2  :  FactRec;
  169.        3  :  UserQuits := True;
  170.     END;
  171.   UNTIL UserQuits;
  172. END.
  173.